home *** CD-ROM | disk | FTP | other *** search
/ Otherware / Otherware_1_SB_Development.iso / mac / developm / language / harvest.cpt / Harvest C / tclCommands.c < prev    next >
Encoding:
C/C++ Source or Header  |  1992-04-25  |  14.1 KB  |  612 lines
  1. /*
  2.     Tcl commands for Harvest C
  3. */
  4.  
  5. #include <string.h>
  6.  
  7. #include "CHarvestApp.h"
  8. #include "CHarvestDoc.h"
  9. #include "CSourceFile.h"
  10. #include "CHarvestOptions.h"
  11. #include "CDataFile.h"
  12. #include "CList.h"
  13. #include "CHarvestPane.h"
  14.  
  15. #include "tcl.h"
  16.  
  17. #define STREQU(A, B)    ( strcmp ( (A) , (B) ) == 0 )
  18.  
  19. extern CHarvestDoc *gProject;
  20. extern CHarvestApp *gApplication;
  21.  
  22. static int
  23. Tcl_newProject(ClientData clientData, Tcl_Interp *interp, int argc, char **argv)
  24. {
  25.     int            myerr;
  26.     short        vrefnum;
  27.     long        dirid;
  28.     char        *ptr1, savech, *namep;
  29.     char        pascal_name[64];
  30.     CHarvestDoc *newDocument;
  31.  
  32.     if (gProject) {
  33.         Tcl_SetResult(interp, "there is a project already open", TCL_STATIC);
  34.         return TCL_ERROR;
  35.     }
  36.     if (argc == 1) {
  37.         gApplication->CreateProject();
  38.         Tcl_SetResult(interp, argv[1], TCL_VOLATILE);
  39.         return TCL_OK;
  40.     }
  41.     if (argc != 2) {
  42.         Tcl_SetResult(interp, "wrong # args", TCL_STATIC);
  43.         return TCL_ERROR;
  44.     }
  45.     else {
  46.         namep = argv[1];
  47.         dirid = current_dirid();
  48.         vrefnum = current_vrefnum();
  49.         ptr1 = strrchr(namep, ':');
  50.         
  51.         if (ptr1 != NULL) {
  52.             savech = *(ptr1+1);
  53.             *(ptr1+1) = '\0';
  54.             dirid = compute_path_dirid(namep);
  55.             *(ptr1+1) = savech;
  56.             strcpy(pascal_name, ptr1 + 1);
  57.             vrefnum = compute_path_vrefnum(namep);
  58.             }
  59.         else
  60.             strcpy(pascal_name, namep);
  61.         
  62.         c2pstr(pascal_name);
  63.         newDocument = new(CHarvestDoc);
  64.         newDocument->IHarvestDoc(gApplication,false);
  65.         newDocument->FSNewFile(pascal_name,vrefnum,dirid);
  66.         Tcl_SetResult(interp, argv[1], TCL_VOLATILE);
  67.         return TCL_OK;
  68.     }
  69. }
  70.  
  71. static int
  72. Tcl_openProject(ClientData clientData, Tcl_Interp *interp, int argc, char **argv)
  73. {
  74.     int            myerr;
  75.     short        vrefnum;
  76.     long        dirid;
  77.     char        *ptr1, savech, *namep;
  78.     char        pascal_name[64];
  79.     CHarvestDoc *newDocument;
  80.     if (gProject) {
  81.         Tcl_SetResult(interp, "there is a project already open", TCL_STATIC);
  82.         return TCL_ERROR;
  83.     }
  84.     if (argc == 1) {
  85.         DoOpenProject();
  86.         Tcl_SetResult(interp, argv[1], TCL_VOLATILE);
  87.         return TCL_OK;
  88.     }
  89.     if (argc != 2) {
  90.         Tcl_SetResult(interp, "wrong # args", TCL_STATIC);
  91.         return TCL_ERROR;
  92.     }
  93.     else {
  94.         namep = argv[1];
  95.         dirid = current_dirid();
  96.         vrefnum = current_vrefnum();
  97.         ptr1 = strrchr(namep, ':');
  98.         
  99.         if (ptr1 != NULL) {
  100.             savech = *(ptr1+1);
  101.             *(ptr1+1) = '\0';
  102.             dirid = compute_path_dirid(namep);
  103.             *(ptr1+1) = savech;
  104.             strcpy(pascal_name, ptr1 + 1);
  105.             vrefnum = compute_path_vrefnum(namep);
  106.             }
  107.         else
  108.             strcpy(pascal_name, namep);
  109.         
  110.         c2pstr(pascal_name);
  111.         newDocument = new(CHarvestDoc);
  112.         newDocument->IHarvestDoc(gApplication,false);
  113.         newDocument->FSOpenFile(pascal_name,vrefnum,dirid);
  114.         if (gProject) {
  115.         Tcl_SetResult(interp, argv[1], TCL_VOLATILE);
  116.         }
  117.         else {
  118.         Tcl_SetResult(interp, "openProject failed", TCL_STATIC);
  119.         }
  120.         return TCL_OK;
  121.     }
  122. }
  123.  
  124. static int
  125. Tcl_closeProject(ClientData clientData, Tcl_Interp *interp, int argc, char **argv)
  126. {
  127.     if (!gProject) {
  128.         Tcl_SetResult(interp, "no project open", TCL_STATIC);
  129.         return TCL_ERROR;
  130.     }
  131.     if (argc != 1) {
  132.         Tcl_SetResult(interp, "wrong # args", TCL_STATIC);
  133.         return TCL_ERROR;
  134.     }
  135.     else {
  136.         gProject->Close(false);
  137.         Tcl_SetResult(interp, "1", TCL_STATIC);
  138.         return TCL_OK;
  139.     }
  140. }
  141.  
  142. static int
  143. Tcl_setOption(ClientData clientData, Tcl_Interp *interp, int argc, char **argv)
  144. {
  145.     int value;
  146.     if (!gProject) {
  147.         Tcl_SetResult(interp, "no project open", TCL_STATIC);
  148.         return TCL_ERROR;
  149.     }
  150.     if (argc != 3) {
  151.         Tcl_SetResult(interp, "wrong # args", TCL_STATIC);
  152.         return TCL_ERROR;
  153.     }
  154.     else {
  155.         value = atoi(argv[2]);
  156.         if (STREQU(argv[1],"trigraphs")) {
  157.             gProject->itsOptions->trigraphs = value;
  158.         }
  159.         if (STREQU(argv[1],"bigGlobals")) {
  160.             gProject->itsOptions->bigGlobals = value;
  161.         }
  162.         if (STREQU(argv[1],"mc68020")) {
  163.             gProject->itsOptions->useMC68020 = value;
  164.         }
  165.         if (STREQU(argv[1],"mc68881")) {
  166.             gProject->itsOptions->useMC68881 = value;
  167.         }
  168.         if (STREQU(argv[1],"signedChars")) {
  169.             gProject->itsOptions->signedChars = value;
  170.         }
  171.         if (STREQU(argv[1],"macsbugSyms")) {
  172.             gProject->itsOptions->MacsBugSymbols = value;
  173.         }
  174.         Tcl_SetResult(interp, argv[2], TCL_VOLATILE);
  175.         return TCL_OK;
  176.     }
  177. }
  178.  
  179. static int
  180. Tcl_setWarnings(ClientData clientData, Tcl_Interp *interp, int argc, char **argv)
  181. {
  182.     int value;
  183.     if (!gProject) {
  184.         Tcl_SetResult(interp, "no project open", TCL_STATIC);
  185.         return TCL_ERROR;
  186.     }
  187.     if (argc != 3) {
  188.         Tcl_SetResult(interp, "wrong # args", TCL_STATIC);
  189.         return TCL_ERROR;
  190.     }
  191.     else {
  192.         value = atoi(argv[2]);
  193.         if (STREQU(argv[1],"all")) {
  194.             if (value) {
  195.                 gProject->itsOptions->allWarnings = 1;
  196.                 gProject->itsOptions->noWarnings = 0;
  197.             }
  198.             else {
  199.                 gProject->itsOptions->allWarnings = 0;
  200.                 gProject->itsOptions->noWarnings = 1;
  201.             }
  202.         }
  203.         /* TODO Search for the warning in the array */
  204.         Tcl_SetResult(interp, argv[2], TCL_VOLATILE);
  205.         return TCL_OK;
  206.     }
  207. }
  208.  
  209. static int
  210. Tcl_setSig(ClientData clientData, Tcl_Interp *interp, int argc, char **argv)
  211. {
  212.     if (!gProject) {
  213.         Tcl_SetResult(interp, "no project open", TCL_STATIC);
  214.         return TCL_ERROR;
  215.     }
  216.     if (argc != 2) {
  217.         Tcl_SetResult(interp, "wrong # args", TCL_STATIC);
  218.         return TCL_ERROR;
  219.     }
  220.     else {
  221.         gProject->itsSignature = MakeOSType(argv[1]);
  222.         Tcl_SetResult(interp, argv[1], TCL_VOLATILE);
  223.         return TCL_OK;
  224.     }
  225. }
  226.  
  227. static int
  228. Tcl_setPartition(ClientData clientData, Tcl_Interp *interp, int argc, char **argv)
  229. {
  230.     if (!gProject) {
  231.         Tcl_SetResult(interp, "no project open", TCL_STATIC);
  232.         return TCL_ERROR;
  233.     }
  234.     if (argc != 2) {
  235.         Tcl_SetResult(interp, "wrong # args", TCL_STATIC);
  236.         return TCL_ERROR;
  237.     }
  238.     else {
  239.         gProject->itsPartition = atoi(argv[1])*1024;
  240.         Tcl_SetResult(interp, argv[1], TCL_VOLATILE);
  241.         return TCL_OK;
  242.     }
  243. }
  244.  
  245. static int
  246. Tcl_setSIZEFlags(ClientData clientData, Tcl_Interp *interp, int argc, char **argv)
  247. {
  248.     if (!gProject) {
  249.         Tcl_SetResult(interp, "no project open", TCL_STATIC);
  250.         return TCL_ERROR;
  251.     }
  252.     if (argc != 2) {
  253.         Tcl_SetResult(interp, "wrong # args", TCL_STATIC);
  254.         return TCL_ERROR;
  255.     }
  256.     else {
  257.         gProject->itsSizeFlags = atoi(argv[1]);
  258.         Tcl_SetResult(interp, argv[1], TCL_VOLATILE);
  259.         return TCL_OK;
  260.     }
  261. }
  262.  
  263. static int
  264. Tcl_bringUpToDate(ClientData clientData, Tcl_Interp *interp, int argc, char **argv)
  265. {
  266.     if (!gProject) {
  267.         Tcl_SetResult(interp, "no project open", TCL_STATIC);
  268.         return TCL_ERROR;
  269.     }
  270.     if (argc != 1) {
  271.         Tcl_SetResult(interp, "wrong # args", TCL_STATIC);
  272.         return TCL_ERROR;
  273.     }
  274.     else {
  275.         if (gProject->BringUpToDate()) {
  276.             Tcl_SetResult(interp, "1", TCL_STATIC);
  277.         }
  278.         else {
  279.             Tcl_SetResult(interp, "0", TCL_STATIC);
  280.         }
  281.         return TCL_OK;
  282.     }
  283. }
  284.  
  285. static int
  286. Tcl_buildApplication(ClientData clientData, Tcl_Interp *interp, int argc, char **argv)
  287. {
  288.     int            myerr;
  289.     short        vrefnum;
  290.     long        dirid;
  291.     char        *ptr1, savech, *namep;
  292.     char        pascal_name[64];
  293.     if (!gProject) {
  294.         Tcl_SetResult(interp, "no project open", TCL_STATIC);
  295.         return TCL_ERROR;
  296.     }
  297.     if (argc == 1) {
  298.         gProject->Link();
  299.         Tcl_SetResult(interp, "1", TCL_STATIC);
  300.         return TCL_OK;
  301.     }
  302.     if (argc != 2) {
  303.         Tcl_SetResult(interp, "wrong # args", TCL_STATIC);
  304.         return TCL_ERROR;
  305.     }
  306.     else {
  307.         namep = argv[1];
  308.         dirid = current_dirid();
  309.         vrefnum = current_vrefnum();
  310.         ptr1 = strrchr(namep, ':');
  311.         
  312.         if (ptr1 != NULL) {
  313.             savech = *(ptr1+1);
  314.             *(ptr1+1) = '\0';
  315.             dirid = compute_path_dirid(namep);
  316.             *(ptr1+1) = savech;
  317.             strcpy(pascal_name, ptr1 + 1);
  318.             vrefnum = compute_path_vrefnum(namep);
  319.             }
  320.         else
  321.             strcpy(pascal_name, namep);
  322.         
  323.         c2pstr(pascal_name);
  324.         
  325.         CopyPString(pascal_name,gProject->StdAppName);
  326.         gProject->StdAppVol = vrefnum;
  327.         gProject->StdAppDir = dirid;
  328.  
  329.         if (gProject->DoLink()) {
  330.             Tcl_SetResult(interp, "1", TCL_STATIC);
  331.         }
  332.         else {
  333.             Tcl_SetResult(interp, "0", TCL_STATIC);
  334.         }
  335.         return TCL_OK;
  336.     }
  337. }
  338.  
  339. static int
  340. Tcl_makeClean(ClientData clientData, Tcl_Interp *interp, int argc, char **argv)
  341. {
  342.     if (!gProject) {
  343.         Tcl_SetResult(interp, "no project open", TCL_STATIC);
  344.         return TCL_ERROR;
  345.     }
  346.     if (argc != 1) {
  347.         Tcl_SetResult(interp, "wrong # args", TCL_STATIC);
  348.         return TCL_ERROR;
  349.     }
  350.     else {
  351.         gProject->Clean();
  352.         Tcl_SetResult(interp, "cleaned", TCL_STATIC);
  353.         return TCL_OK;
  354.     }
  355. }
  356.  
  357. static int
  358. Tcl_runApplication(ClientData clientData, Tcl_Interp *interp, int argc, char **argv)
  359. {
  360.     if (!gProject) {
  361.         Tcl_SetResult(interp, "no project open", TCL_STATIC);
  362.         return TCL_ERROR;
  363.     }
  364.     if (argc != 1) {
  365.         Tcl_SetResult(interp, "wrong # args", TCL_STATIC);
  366.         return TCL_ERROR;
  367.     }
  368.     else {
  369.         gProject->RunApp();
  370.         Tcl_SetResult(interp, "1", TCL_STATIC);
  371.         return TCL_OK;
  372.     }
  373. }
  374.  
  375. static int
  376. Tcl_addFiles(ClientData clientData, Tcl_Interp *interp, int argc, char **argv)
  377. {
  378.     int            myerr;
  379.     short        vrefnum;
  380.     long        dirid;
  381.     char        *ptr1, savech, *namep;
  382.     char        pascal_name[64];
  383.     int i;
  384.     int len;
  385.     if (argc <= 1) {
  386.         Tcl_SetResult(interp, "wrong # args", TCL_STATIC);
  387.         return TCL_ERROR;
  388.     }
  389.     else {
  390.         if (!gProject) {
  391.             Tcl_SetResult(interp, "no project open", TCL_STATIC);
  392.             return TCL_ERROR;
  393.         }
  394.         for (i=1; i<=(argc-1); i++) {
  395.             namep = argv[1];
  396.             dirid = current_dirid();
  397.             vrefnum = current_vrefnum();
  398.             ptr1 = strrchr(namep, ':');
  399.             
  400.             if (ptr1 != NULL) {
  401.                 savech = *(ptr1+1);
  402.                 *(ptr1+1) = '\0';
  403.                 dirid = compute_path_dirid(namep);
  404.                 *(ptr1+1) = savech;
  405.                 strcpy(pascal_name, ptr1 + 1);
  406.                 vrefnum = compute_path_vrefnum(namep);
  407.                 }
  408.             else
  409.                 strcpy(pascal_name, namep);
  410.             
  411.             c2pstr(pascal_name);
  412.             len = pascal_name[0];
  413.             if (pascal_name[len-1] == '.') {
  414.                 if (pascal_name[len] == 'o') {
  415.                     /* TODO Should make sure file is 'OBJ ' */
  416.                     gProject->AddLibraryFileHFS((unsigned char *) pascal_name,vrefnum,dirid);
  417.                 }
  418.                 else {
  419.                     /* TODO Should make sure file is 'TEXT' */
  420.                     gProject->AddSourceFileHFS((unsigned char *) pascal_name,vrefnum,dirid);
  421.                 }
  422.             }
  423.             else {
  424.                     /* TODO Should make sure file is 'rsrc' */
  425.                 gProject->AddResourceFileHFS((unsigned char *) pascal_name,vrefnum,dirid);
  426.             }
  427.         }    
  428.  
  429.         Tcl_SetResult(interp, "1", TCL_STATIC);
  430.         return TCL_OK;
  431.     }
  432. }
  433.  
  434. static int
  435. Tcl_removeFiles(ClientData clientData, Tcl_Interp *interp, int argc, char **argv)
  436. {
  437.     int            myerr;
  438.     short        vrefnum;
  439.     long        dirid;
  440.     char        *ptr1, savech, *namep;
  441.     char        pascal_name[64];
  442.     int i;
  443.     int ndx;
  444.     if (argc <= 1) {
  445.         Tcl_SetResult(interp, "wrong # args", TCL_STATIC);
  446.         return TCL_ERROR;
  447.     }
  448.     else {
  449.         if (!gProject) {
  450.             Tcl_SetResult(interp, "no project open", TCL_STATIC);
  451.             return TCL_ERROR;
  452.         }
  453.         for (i=1; i<=(argc-1); i++) {
  454.             namep = argv[1];
  455.             dirid = current_dirid();
  456.             vrefnum = current_vrefnum();
  457.             ptr1 = strrchr(namep, ':');
  458.             
  459.             if (ptr1 != NULL) {
  460.                 savech = *(ptr1+1);
  461.                 *(ptr1+1) = '\0';
  462.                 dirid = compute_path_dirid(namep);
  463.                 *(ptr1+1) = savech;
  464.                 strcpy(pascal_name, ptr1 + 1);
  465.                 vrefnum = compute_path_vrefnum(namep);
  466.                 }
  467.             else
  468.                 strcpy(pascal_name, namep);
  469.             
  470.             c2pstr(pascal_name);
  471.             
  472.             ndx = gProject->FindFile(pascal_name,vrefnum,dirid);
  473.             if (ndx) {
  474.                 gProject->itsSourceFiles->Remove(gProject->itsSourceFiles->NthItem(ndx));
  475.                 gProject->itsTable->DeleteRow(1,ndx);
  476.                 gProject->itsTable->DeselectAll(true);
  477.             }
  478.         }    
  479.         Tcl_SetResult(interp, "1", TCL_STATIC);
  480.         return TCL_OK;
  481.     }
  482. }
  483.  
  484. static int
  485. Tcl_compile(ClientData clientData, Tcl_Interp *interp, int argc, char **argv)
  486. {
  487.     int            myerr;
  488.     short        vrefnum;
  489.     long        dirid;
  490.     char        *ptr1, savech, *namep;
  491.     char        pascal_name[64];
  492.     int ndx;
  493.     CSourceFile *srcFile;
  494.  
  495.     if (argc != 2) {
  496.         Tcl_SetResult(interp, "wrong # args", TCL_STATIC);
  497.         return TCL_ERROR;
  498.     }
  499.     else {
  500.         if (!gProject) {
  501.             Tcl_SetResult(interp, "no project open", TCL_STATIC);
  502.             return TCL_ERROR;
  503.         }
  504.         namep = argv[1];
  505.         dirid = current_dirid();
  506.         vrefnum = current_vrefnum();
  507.         ptr1 = strrchr(namep, ':');
  508.         
  509.         if (ptr1 != NULL) {
  510.             savech = *(ptr1+1);
  511.             *(ptr1+1) = '\0';
  512.             dirid = compute_path_dirid(namep);
  513.             *(ptr1+1) = savech;
  514.             strcpy(pascal_name, ptr1 + 1);
  515.             vrefnum = compute_path_vrefnum(namep);
  516.             }
  517.         else
  518.             strcpy(pascal_name, namep);
  519.         
  520.         c2pstr(pascal_name);
  521.         
  522.         ndx = gProject->FindFile(pascal_name,vrefnum,dirid);
  523.         if (ndx) {
  524.             srcFile = (CSourceFile *) gProject->itsSourceFiles->NthItem(ndx);
  525.             if (srcFile->itsKind == H_SourceFile) {
  526.                 srcFile->Compile();
  527.             }
  528.         }
  529.             
  530.         Tcl_SetResult(interp, "0", TCL_STATIC);
  531.         return TCL_OK;
  532.     }
  533. }
  534.  
  535. static int
  536. Tcl_openFile(ClientData clientData, Tcl_Interp *interp, int argc, char **argv)
  537. {
  538.     if (argc != 2) {
  539.         Tcl_SetResult(interp, "wrong # args", TCL_STATIC);
  540.         return TCL_ERROR;
  541.     }
  542.     else {
  543.         if (!gProject) {
  544.             Tcl_SetResult(interp, "no project open", TCL_STATIC);
  545.             return TCL_ERROR;
  546.         }
  547.         /* TODO send an AE to open the given file - return success */
  548.         Tcl_SetResult(interp, "openFile currently not implemented", TCL_STATIC);
  549.         return TCL_OK;
  550.     }
  551. }
  552.  
  553. static int
  554. Tcl_listProject(ClientData clientData, Tcl_Interp *interp, int argc, char **argv)
  555. {
  556.     int CountSourceFiles;
  557.     int i;
  558.     CSourceFile *aFile;
  559.     CDataFile *theFile;
  560.     char name[256];
  561.  
  562.     if (argc != 1) {
  563.         Tcl_SetResult(interp, "wrong # args", TCL_STATIC);
  564.         return TCL_ERROR;
  565.     }
  566.     else {
  567.         if (!gProject) {
  568.             Tcl_SetResult(interp, "no project open", TCL_STATIC);
  569.             return TCL_ERROR;
  570.         }
  571.     
  572.         Tcl_ResetResult(interp);
  573.  
  574.         CountSourceFiles = gProject->itsSourceFiles->GetNumItems();
  575.         for (i=1;i<=CountSourceFiles;i++) {
  576.             aFile = (CSourceFile *) gProject->itsSourceFiles->NthItem(i);
  577.             theFile = aFile->theFile;
  578.             CopyPString(theFile->name,name);
  579.             p2cstr(name);
  580.             Tcl_AppendElement(interp,name,0);
  581.         }
  582.         return TCL_OK;
  583.     }
  584. }
  585.  
  586. void
  587. InitHarvestTcl(Tcl_Interp *interp)
  588. {
  589.     int        result;
  590.  
  591.     Tcl_CreateCommand(interp, "newProject", Tcl_newProject, NULL, NULL);
  592.     Tcl_CreateCommand(interp, "openProject", Tcl_openProject, NULL, NULL);
  593.     Tcl_CreateCommand(interp, "closeProject", Tcl_closeProject, NULL, NULL);
  594.     Tcl_CreateCommand(interp, "setOption", Tcl_setOption, NULL, NULL);
  595.     Tcl_CreateCommand(interp, "setWarnings", Tcl_setWarnings, NULL, NULL);
  596.     Tcl_CreateCommand(interp, "setSig", Tcl_setSig, NULL, NULL);
  597.     Tcl_CreateCommand(interp, "setPartition", Tcl_setPartition, NULL, NULL);
  598.     Tcl_CreateCommand(interp, "setSIZEFlags", Tcl_setSIZEFlags, NULL, NULL);
  599.     Tcl_CreateCommand(interp, "bringUpToDate", Tcl_bringUpToDate, NULL, NULL);
  600.     Tcl_CreateCommand(interp, "buildApplication", Tcl_buildApplication, NULL, NULL);
  601.     Tcl_CreateCommand(interp, "makeClean", Tcl_makeClean, NULL, NULL);
  602.     Tcl_CreateCommand(interp, "runApplication", Tcl_runApplication, NULL, NULL);
  603.     Tcl_CreateCommand(interp, "addFiles", Tcl_addFiles, NULL, NULL);
  604.     Tcl_CreateCommand(interp, "removeFiles", Tcl_removeFiles, NULL, NULL);
  605.     Tcl_CreateCommand(interp, "compile", Tcl_compile, NULL, NULL);
  606.     Tcl_CreateCommand(interp, "listProject", Tcl_listProject, NULL, NULL);
  607.     Tcl_CreateCommand(interp, "openFile", Tcl_openFile, NULL, NULL);
  608.  
  609. }
  610.  
  611.  
  612.